home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_2
/
turbo1.zip
/
FSSERIAL.ZIP
/
ANSIVIEW.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-01-29
|
20KB
|
705 lines
Unit AnsiView;
{ ANSIVIEW.PAS - 24 January 1991
By Marcos R. Della
5084 Rincon Ave.
Santa Rosa, CA 95409
CIS: 71675,765
This Unit was written so that I had something that reminded me of the
original WRITELN and WRITE statments of pascal where I was working
with the screen and there were various definate controls I had using
the GOTOXY and CLRSCR routines. Under TVision, you no longer have
these controls and need to learn a completely different way of getting
info on the screen.
AnsiView was written to give you some of these old methods while still
using the TVision platform. That is, your screen is a scroll window of
your size choosing (You can define a screen 128,2048 and use the gotoxy
to get to anywhere on that screen!) Also if you turn on the ANSI
option, the driver will recognise ANSI controls (For reading those ANSI
files directly and displaying them!)
Because this is also a TVision enviroment, your screen will also be
saved if you do a desktop save! Wonderful stuff eh?
NOTE!!! Registration values used by this Unit
TANSIView = 7200;
TInterior = 7201;
--------------------
Modification History
--------------------
29 January 1991 - Added the code to handle 15 of the ANSI control
characters if they are passed to the ANSIView
routines. There are two commands that will no work with this current
implementation. The <ESC>[xP and <ESC>[x@ for insert and delete
characters on the current line. These should be supported in the
near future whenever I get back to working on this unit...
There is a problem with the cursor positioning not always updating
the onscreen cursor display (if you have it on) however with the
printing of any character or other command, it comes back on. I'm
still scratching my head over this one.
}
{$F+,O+,R-,S-}
Interface
Uses Dos, Drivers, Views, Objects, Memory;
CONST MaxViewHeight = 2048;
TYPE PScreenL = ^TScreenL;
TScreenL = ARRAY[0..MaxViewWidth - 1] OF WORD;
PScreenR = ^TScreenR;
TScreenR = ARRAY[0..MaxViewHeight - 1] OF PScreenL;
PInterior = ^TInterior;
TInterior = OBJECT(TScroller)
AutoScroll : BOOLEAN;
MaxDim : TPoint;
CurLoc : TPoint;
TopPtr : PScreenR;
CONSTRUCTOR Init(VAR Bounds : TRect; Limits : TPoint;
Color : BYTE; AHScrollBar, AVScrollBar : PScrollBar);
CONSTRUCTOR Load(VAR S : TStream);
PROCEDURE Store(VAR S : TStream);
PROCEDURE Draw; VIRTUAL;
PROCEDURE PrintChar(Ch : CHAR; VAR TextAttr : BYTE);
DESTRUCTOR Done; VIRTUAL;
END;
ParmsFld = ARRAY[1..9] OF BYTE;
PANSIView = ^TANSIView;
TANSIView = OBJECT(TWindow)
UseANSI : BOOLEAN;
StateInfo : BYTE;
ESCBuf : STRING[126];
ANSIParms : ParmsFld;
ParmsIdx : BYTE;
EndString : CHAR;
CurHold : TPoint;
TextAttr : BYTE;
Interior : PInterior;
CONSTRUCTOR Init(Bounds : TRect; Limits : TPoint; WnTitle : STRING; WindowNo : WORD);
CONSTRUCTOR Load(VAR S : TStream);
PROCEDURE Store(VAR S : TStream);
FUNCTION ProcessChar(Ch : CHAR) : BOOLEAN;
PROCEDURE PrintLN(s : STRING);
PROCEDURE Print(s : STRING);
PROCEDURE PrintChar(Ch : CHAR);
PROCEDURE PutChar(X, Y : WORD; Ch : CHAR; Attr : BYTE);
PROCEDURE CursorOn;
PROCEDURE CursorOff;
PROCEDURE AutoScrollOn;
PROCEDURE AutoScrollOff;
PROCEDURE ClrScr;
PROCEDURE ClrEol;
PROCEDURE DelLine;
PROCEDURE GotoXY(X,Y : WORD);
PROCEDURE HighVideo;
PROCEDURE InsLine;
PROCEDURE LowVideo;
PROCEDURE TextBackground(Color : BYTE);
PROCEDURE TextColor(Color : BYTE);
FUNCTION WhereX : BYTE;
FUNCTION WhereY : WORD;
END;
CONST RANSIView: TStreamRec = (
ObjType: 7200;
VmtLink: Ofs(TypeOf(TANSIView)^);
Load: @TANSIView.Load;
Store: @TANSIView.Store
);
RInterior: TStreamRec = (
ObjType: 7201;
VmtLink: Ofs(TypeOf(TInterior)^);
Load: @TInterior.Load;
Store: @TInterior.Store
);
PROCEDURE RegisterANSIView;
Implementation
{----------------------------------------------------------------------------}
FUNCTION Min(X,Y : INTEGER) : INTEGER; ASSEMBLER;
ASM
MOV AX,X
CMP AX,Y
JLE @@1
MOV AX,Y
@@1:
END;
FUNCTION Max(X,Y : INTEGER) : INTEGER; ASSEMBLER;
ASM
MOV AX,X
CMP AX,Y
JGE @@1
MOV AX,Y
@@1:
END;
{----------------------------------------------------------------------------}
CONSTRUCTOR TInterior.Init;
VAR i,j : WORD;
BEGIN
TScroller.Init(Bounds,AHScrollBar,AVScrollBar);
MaxDim := Limits;
AutoScroll := TRUE;
CurLoc.X := 0;
CurLoc.Y := 0;
TopPtr := MemAlloc(MaxDim.Y * SIZEOF(PScreenR)); {Allocate All Y Coords}
IF TopPtr = NIL THEN
BEGIN
TScroller.Done;
FAIL
END;
FOR i := 0 TO MaxDim.Y - 1 DO BEGIN {Now for each line}
TopPtr^[i] := MemAlloc(MaxDim.X * SIZEOF(WORD));
IF TopPtr^[i] = NIL THEN
BEGIN
IF i > 0 THEN
FOR j := 0 TO i - 1 DO
FREEMEM(TopPtr^[j],MaxDim.X * SIZEOF(WORD));
FREEMEM(TopPtr,MaxDim.Y * SIZEOF(PScreenR));
TScroller.Done;
FAIL
END
ELSE
MoveChar(TopPtr^[i]^,' ',Color,MaxDim.X)
END;
GrowMode := gfGrowHiX + gfGrowHiY;
DragMode := dmLimitLoX + dmLimitLoY;
SetLimit(MaxDim.X,MaxDim.Y);
END;
CONSTRUCTOR TInterior.Load;
VAR i,j : INTEGER;
ok : BOOLEAN;
B : TDrawBuffer;
BEGIN
TScroller.Load(S);
S.Read(AutoScroll,SIZEOF(AutoScroll));
S.Read(CurLoc,SIZEOF(CurLoc));
S.Read(MaxDim,SIZEOF(MaxDim));
TopPtr := MemAlloc(MaxDim.Y * SIZEOF(PScreenR));
ok := (TopPtr <> NIL);
FOR i := 0 TO MaxDim.Y - 1 DO BEGIN
S.Read(B,MaxDim.X * SIZEOF(WORD));
IF ok THEN
BEGIN
TopPtr^[i] := MemAlloc(MaxDim.X * SIZEOF(WORD));
ok := ok AND (TopPtr^[i] <> NIL);
IF ok THEN
MOVE(B,TopPtr^[i]^,MaxDim.X * SIZEOF(WORD))
ELSE
IF i > 0 THEN
FOR j := 0 TO i - 1 DO
FREEMEM(TopPtr^[j],MaxDim.X * SIZEOF(WORD));
END
END;
IF NOT ok THEN
BEGIN
FREEMEM(TopPtr,MaxDim.Y * SIZEOF(PScreenR));
TScroller.Done;
FAIL
END;
GrowMode := gfGrowHiX + gfGrowHiY;
SetLimit(MaxDim.X,MaxDim.Y)
END;
PROCEDURE TInterior.Store;
VAR i : INTEGER;
BEGIN
TScroller.Store(S);
S.Write(AutoScroll,SIZEOF(AutoScroll));
S.Write(CurLoc,SIZEOF(CurLoc));
S.Write(MaxDim,SIZEOF(MaxDim));
FOR i := 0 TO MaxDim.Y - 1 DO
S.Write(TopPtr^[i]^,MaxDim.X * SIZEOF(WORD));
END;
PROCEDURE TInterior.Draw;
VAR Y : INTEGER;
BEGIN
FOR Y := 0 TO Size.Y - 1 DO
WriteLine(0,Y,Size.X,1,TopPtr^[Delta.Y + Y]^[Delta.X])
END;
PROCEDURE TInterior.PrintChar;
VAR PPtr : PScreenL;
Y : INTEGER;
BEGIN
CASE ch OF
#0 : ;
#8 : DEC(CurLoc.X);
#10 : INC(CurLoc.Y);
#13 : CurLoc.X := 0;
ELSE BEGIN
MoveChar(TopPtr^[CurLoc.Y]^[CurLoc.X],ch,TextAttr,1);
INC(CurLoc.X)
END;
END;
{Next insure that the X position didn't go out of bounds.}
{If it did, then set it back in bounds and scroll if needed.}
CurLoc.X := Max(CurLoc.X,0);
IF CurLoc.X >= MaxDim.X THEN
BEGIN
INC(CurLoc.Y);
CurLoc.X := 0
END;
{Finally check to see if we went beyond the Y Coordinate and need to}
{scroll the screen up a line for the next line to be put on.}
IF CurLoc.Y >= MaxDim.Y THEN
BEGIN
DEC(CurLoc.Y);
PPtr := TopPtr^[0];
MoveChar(PPtr^,' ',TextAttr,MaxDim.X);
MOVE(TopPtr^[1],TopPtr^[0],(MaxDim.Y - 1) * SIZEOF(PScreenL));
TopPtr^[MaxDim.Y - 1] := PPtr;
DrawView
END;
IF AutoScroll AND (Size.Y <= CurLoc.Y - Delta.Y) THEN
VScrollBar^.SetValue(Max(CurLoc.Y - Size.Y + 1,0));
Cursor.X := CurLoc.X - Delta.X;
Cursor.Y := CurLoc.Y - Delta.Y
END;
DESTRUCTOR TInterior.Done;
VAR i : WORD;
BEGIN
FOR i := 0 TO MaxDim.Y - 1 DO
FREEMEM(TopPtr^[i],MaxDim.X * SIZEOF(WORD));
FREEMEM(TopPtr,MaxDim.Y * SIZEOF(PScreenR));
TScroller.Done
END;
{----------------------------------------------------------------------------}
CONSTRUCTOR TANSIView.Init;
VAR HScrollBar,
VScrollBar : PScrollBar;
BEGIN
TWindow.Init(Bounds,WnTitle,WindowNo);
TextAttr := $1E;
GetExtent(Bounds);
Bounds.Grow(-1,-1);
Limits.X := Max(Limits.X,MinWinSize.X);
Limits.X := Min(Limits.X,MaxViewHeight);
Limits.X := Max(Limits.X,Bounds.B.X - Bounds.A.X);
Limits.Y := Max(Limits.Y,MinWinSize.Y);
Limits.Y := Min(Limits.Y,MaxViewWidth);
Limits.Y := Max(Limits.Y,Bounds.B.Y - Bounds.A.Y);
VScrollBar := StandardScrollBar(sbVertical);
HScrollBar := StandardScrollBar(sbHorizontal);
Interior := NEW(PInterior,Init(Bounds,Limits,TextAttr,HScrollBar,VScrollBar));
IF Interior = NIL THEN
BEGIN
TWindow.Done;
FAIL
END;
UseANSI := TRUE;
StateInfo := 0;
ESCBuf := '';
CurHold.X := 0;
CurHold.Y := 0;
Insert(Interior)
END;
CONSTRUCTOR TANSIView.Load;
BEGIN
TWindow.Load(S);
GetPeerViewPtr(S,Interior);
S.Read(TextAttr,SIZEOF(TextAttr));
S.Read(UseANSI,SIZEOF(UseANSI));
S.Read(CurHold,SIZEOF(CurHold));
StateInfo := 0;
ESCBuf := ''
END;
PROCEDURE TANSIView.Store;
BEGIN
TWindow.Store(S);
PutPeerViewPtr(S,Interior);
S.Write(TextAttr,SIZEOF(TextAttr));
S.Write(UseANSI,SIZEOF(UseANSI));
S.Write(CurHold,SIZEOF(CurHold));
END;
FUNCTION TANSIView.ProcessChar(Ch : CHAR) : BOOLEAN;
PROCEDURE ChangeTextAttr(VAR TAttr : BYTE; PNum : BYTE; PFld : ParmsFld);
CONST Colors = 22;
ColorTbl : ARRAY[1..Colors,1..3] OF BYTE =
((0, $00, $07), (5, $FF, $80),
(1, $FF, $08), (7, $F8, $70),
(4, $F8, $01), (8, $88, $00),
(30, $F8, $00), (40, $8F, $00),
(31, $F8, $04), (41, $8F, $40),
(32, $F8, $02), (42, $8F, $20),
(33, $F8, $06), (43, $8F, $60),
(34, $F8, $01), (44, $8F, $10),
(35, $F8, $05), (45, $8F, $50),
(36, $F8, $03), (46, $8F, $30),
(37, $F8, $07), (47, $8F, $70));
BEGIN
ASM
mov si,OFFSET ANSIParms
xor cx,cx
mov cl,PNum
or cx,cx
jnz @sgr_loop
mov [si],cl
inc cx
@sgr_loop:
lodsb
push cx
mov cx,Colors
mov bx,OFFSET ColorTbl - 3
@sgr_search:
add bx,3
cmp al,[bx]
loopne @sgr_search
jne @sgr_loopx
mov cx,1[bx]
les bx,TAttr
mov al,es:[bx]
and al,cl
or al,ch
mov es:[bx],al
@sgr_loopx:
pop cx
loop @sgr_loop
END
END;
PROCEDURE ProcessCommand(Ch : CHAR);
VAR loop : INTEGER;
CurL : TPoint;
BEGIN
WITH Interior^ DO BEGIN
IF (Ch = 'J') AND (ANSIParms[1] = 2) THEN { Special Case... }
BEGIN { Handle regardless }
ClrScr; { of UseANSI status }
EXIT
END;
IF NOT UseANSI THEN
EXIT;
CurL.X := CurLoc.X + 1;
CurL.Y := CurLoc.Y + 1;
CASE Ch OF
'@' : ;
'A' : GotoXY(CurL.X,Max(0,CurL.Y - ANSIParms[1]));
'B' : GotoXY(CurL.X,Min(MaxDim.Y,CurL.Y + ANSIParms[1]));
'C' : GotoXY(Min(CurL.X + ANSIParms[1],MaxDim.X),CurL.Y);
'D' : GotoXY(Max(CurL.X - ANSIParms[1],0) + 1,CurL.Y);
'H','f' : BEGIN
IF ParmsIdx < 2 THEN
ANSIParms[2] := 1;
ANSIParms[1] := Min(MaxDim.Y,ANSIParms[1]);
ANSIParms[2] := Min(MaxDim.X,ANSIParms[2]);
GotoXY(ANSIParms[2],ANSIParms[1]);
END;
'J' : IF ANSIParms[1] = 2 THEN
ClrScr;
'K' : ClrEol;
'L' : FOR Loop := 1 TO ANSIParms[1] DO
InsLine;
'M' : FOR Loop := 1 TO ANSIParms[1] DO
DelLine;
'P' : ;
'm' : ChangeTextAttr(TextAttr,ParmsIdx,ANSIParms);
's' : CurHold := CurL;
'u' : GotoXY(CurHold.X,CurHold.Y);
ELSE EXIT
END
END;
ESCBuf := ''
END;
LABEL ReEval;
VAR i : INTEGER;
BEGIN
ProcessChar := FALSE;
IF StateInfo > 0 THEN
BEGIN
ESCBuf := ESCBuf + Ch;
ReEval:
CASE StateInfo OF
{f_bracket}
1 : StateInfo := ORD(Ch = '[') SHL 1;
{f_get_args}
2 : BEGIN
StateInfo := 3;
ParmsIdx := 0;
FILLCHAR(ANSIParms,SIZEOF(ANSIParms),1);
IF (Ch <> '=') AND (Ch <> '?') THEN
GOTO ReEval
END;
{f_get_param}
3 : IF (Ch >= '0') AND (Ch <= '9') THEN
BEGIN
INC(ParmsIdx);
ANSIParms[ParmsIdx] := ORD(Ch) - $30;
StateInfo := 6
END
ELSE
IF (Ch = '''') OR (Ch = '"') THEN
BEGIN
StateInfo := 4;
EndString := Ch
END
ELSE
BEGIN
StateInfo := 7;
GOTO ReEval
END;
{f_get_string}
4 : INC(StateInfo,ORD(Ch = EndString))
{f_eat_semi}
5 : StateInfo := ORD(Ch = ';') * 3;
{f_in_param}
6 : IF (Ch >= '0') AND (Ch <= '9') THEN
ANSIParms[ParmsIdx] := ANSIParms[ParmsIdx] * 10
+ ORD(Ch) - $30
ELSE
BEGIN
StateInfo := 7;
GOTO ReEval
END;
{fgp_semi_or_cmd}
7 : BEGIN
StateInfo := ORD(Ch = ';') * 3;
IF StateInfo = 0 THEN
ProcessCommand(Ch)
END
END;
IF (StateInfo = 0) AND (LENGTH(ESCBuf) > 0) THEN
BEGIN
FOR i := 1 TO LENGTH(ESCBuf) DO
Interior^.PrintChar(ESCBuf[1],TextAttr);
ESCBuf := '';
ParmsIdx := 0;
ProcessChar := TRUE
END
END
ELSE
IF Ch <> #27 THEN
BEGIN
Interior^.PrintChar(Ch,TextAttr);
ProcessChar := TRUE
END
ELSE
StateInfo := 1;
END;
PROCEDURE TANSIView.PrintLN;
BEGIN
Print(s + #13 + #10)
END;
PROCEDURE TANSIView.Print;
VAR Loop : INTEGER;
ValidDisp : BOOLEAN;
BEGIN
IF LENGTH(s) > 0 THEN
BEGIN
ValidDisp := FALSE;
FOR Loop := 1 TO LENGTH(s) DO
ValidDisp := ProcessChar(s[Loop]) OR ValidDisp;
IF ValidDisp THEN
BEGIN
SetCursor(Interior^.CurLoc.X,Interior^.CurLoc.Y);
Interior^.DrawView
END
END
END;
PROCEDURE TANSIView.PrintChar;
BEGIN
IF ProcessChar(Ch) THEN
BEGIN
SetCursor(Interior^.CurLoc.X,Interior^.CurLoc.Y);
Interior^.DrawView
END
END;
PROCEDURE TANSIView.PutChar;
BEGIN
IF (X >= 0) AND (X < Interior^.MaxDim.X) AND
(Y >= 0) AND (Y < Interior^.MaxDim.Y) THEN
BEGIN
IF ch <> #0 THEN
WordRec(Interior^.TopPtr^[Y]^[X]).LO := ORD(Ch);
IF Attr <> 0 THEN
WordRec(Interior^.TopPtr^[Y]^[X]).HI := Attr;
Interior^.DrawView
END
END;
PROCEDURE TANSIView.CursorOn;
BEGIN
Interior^.ShowCursor
END;
PROCEDURE TANSIView.CursorOff;
BEGIN
Interior^.HideCursor
END;
PROCEDURE TANSIView.AutoScrollOn;
BEGIN
Interior^.AutoScroll := TRUE
END;
PROCEDURE TANSIView.AutoScrollOff;
BEGIN
Interior^.AutoScroll := FALSE
END;
PROCEDURE TANSIView.ClrScr;
VAR i : INTEGER;
BEGIN
SetCursor(0,0);
Interior^.CurLoc.X := 0;
Interior^.CurLoc.Y := 0;
FOR i := 0 TO Interior^.MaxDim.Y - 1 DO
MoveChar(Interior^.TopPtr^[i]^,' ',TextAttr,Interior^.MaxDim.X);
Interior^.VScrollBar^.SetValue(0);
Interior^.HScrollBar^.SetValue(0);
Interior^.DrawView
END;
PROCEDURE TANSIView.ClrEol;
BEGIN
WITH Interior^ DO BEGIN
MoveChar(TopPtr^[CurLoc.Y]^[CurLoc.X],' ',TextAttr,MaxDim.X - CurLoc.X);
DrawView
END
END;
PROCEDURE TANSIView.DelLine;
VAR PPtr : PScreenL;
BEGIN
WITH Interior^ DO BEGIN
PPtr := TopPtr^[CurLoc.Y];
IF CurLoc.Y < MaxDim.Y - 1 THEN
MOVE(TopPtr^[CurLoc.Y + 1],TopPtr^[CurLoc.Y],(MaxDim.Y - CurLoc.Y) * SIZEOF(PScreenL));
TopPtr^[MaxDim.Y - 1] := PPtr;
MoveChar(PPtr^,' ',TextAttr,MaxDim.X);
DrawView
END
END;
PROCEDURE TANSIView.GotoXY;
BEGIN
WITH Interior^ DO BEGIN
CurLoc.X := Max(X - 1,0);
CurLoc.X := Min(CurLoc.X,MaxDim.X);
CurLoc.Y := Max(Y - 1,0);
CurLoc.Y := Min(CurLoc.Y,MaxDim.Y);
SetCursor(CurLoc.X,CurLoc.Y)
END
END;
PROCEDURE TANSIView.HighVideo;
BEGIN
TextAttr := TextAttr OR $08
END;
PROCEDURE TANSIView.InsLine;
VAR PPtr : PScreenL;
BEGIN
WITH Interior^ DO BEGIN
PPtr := TopPtr^[MaxDim.Y - 1];
IF CurLoc.Y < MaxDim.Y - 1 THEN
MOVE(TopPtr^[CurLoc.Y],TopPtr^[CurLoc.Y + 1],(MaxDim.Y - CurLoc.Y) * SIZEOF(PScreenL));
TopPtr^[CurLoc.Y] := PPtr;
MoveChar(PPtr^,' ',TextAttr,MaxDim.X);
DrawView
END
END;
PROCEDURE TANSIView.LowVideo;
BEGIN
TextAttr := TextAttr AND (NOT $08)
END;
PROCEDURE TANSIView.TextBackground;
BEGIN
TextAttr := (Color AND $03) SHL 4 + (TextAttr AND $8F)
END;
PROCEDURE TANSIView.TextColor;
BEGIN
TextAttr := (TextAttr AND $70) + (Color AND $0F)
END;
FUNCTION TANSIView.WhereX;
BEGIN
WhereX := Interior^.CurLoc.X
END;
FUNCTION TANSIView.WhereY;
BEGIN
WhereY := Interior^.CurLoc.Y
END;
{----------------------------------------------------------------------------}
PROCEDURE RegisterANSIView;
BEGIN
RegisterType(RANSIView);
RegisterType(RInterior);
END;
END.